home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / formatvb / sample2.bas < prev   
BASIC Source File  |  1999-08-20  |  25KB  |  654 lines
  1. Attribute VB_Name = "OrderCommon"
  2. Option Explicit
  3. Public Const scPREV_INSTANCE_RUNNING = "Cannot run more than one instance of this application. Please use the currently running one."
  4. Private Const icINVALID_PARM_COUNT = 123
  5. Private Const scZIP_CODE = "ZipCode"
  6. ' Modes for frmActor
  7. Public Enum ACTOR_MODE
  8. icADD_ADDRESS = 1
  9. icEDIT_ADDRESS = 2
  10. icDISPLAY_ADDRESS = 3
  11. icADD_CUSTOMER = 4
  12. End Enum
  13. ' Modes for frmActors
  14. Public Enum ACTORS_MODE
  15. icGET_CUSTOMER = 1
  16. icGET_SUPPLIER = 2
  17. icGET_EMPLOYEE = 3
  18. End Enum
  19. ' Modes for frmOrder
  20. Public Enum ORDER_MODE
  21. icBASE_MENU = 1
  22. icADD_PURCHASE_ORDER = 2
  23. icDISPLAY_PURCHASE_ORDER = 3
  24. icDISPLAY_SALES_ORDER = 6
  25. End Enum
  26. ' Modes for frmOrders
  27. Public Enum ORDERS_MODE
  28. icPURCHASE_ORDERS = 1
  29. icSALES_ORDERS = 2
  30. End Enum
  31. Dim iPrms As Integer
  32. Dim sQry As String
  33. ' Column types for VToSQL
  34. Private Enum COL_TYPE
  35. icDATE = 1
  36. icFOREIGN_KEY = 2
  37. icNUMBER = 3
  38. icOTHER = 4
  39. icSTRING = 5
  40. icNON_EMPTY_STRING = 6
  41. End Enum
  42. Dim sQry As String
  43. Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" _
  44. (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
  45. ByRef lpType As Long, ByVal szData As String, ByRef lpcbData As Long) As Long
  46. Private Declare Function RegCreateKeyEx Lib "advapi32" Alias "RegCreateKeyExA" _
  47. (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, _
  48. ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, _
  49. lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, _
  50. lpdwDisposition As Long) As Long
  51. Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" _
  52. (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, _
  53. lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, _
  54. lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long
  55. Public Function Insert(Optional oContact As cContact, _
  56. Optional oCustomer As cCustomer, _
  57. Optional oEmployee As cEmployee) As Boolean
  58. ' Insert contact, customer or employee data object into database
  59. Dim iPrms   As Integer
  60. Dim sQry    As String
  61. ' Initialize return value
  62. Insert = False
  63. ' Allow only one parameter
  64. iPrms = 0
  65. If Not oContact Is Nothing Then
  66. iPrms = iPrms + 1
  67. End If
  68. If Not oCustomer Is Nothing Then
  69. iPrms = iPrms + 1
  70. End If
  71. If Not oEmployee Is Nothing Then
  72. iPrms = iPrms + 1
  73. End If
  74. If iPrms <> 1 Then
  75. Err.Raise icINVALID_PARM_COUNT, OBJNAME, scINVALID_PARM_COUNT
  76. Exit Function
  77. End If
  78. If Not oContact Is Nothing Then
  79. ' Inserting a Contact
  80. ' Construct SQL statement
  81. With oContact
  82. sQry = "INSERT INTO contacts (ContactType, _
  83. LastName, _
  84. FirstName, _
  85. Address1, _
  86. Address2, _
  87. City, _
  88. State, _
  89. ZipCode, _
  90. PhoneNumber) VALUES (" & _
  91. VToSQL(.ContactType, icNON_EMPTY_STRING) & _
  92. scCS & VToSQL(.LastName, icNON_EMPTY_STRING) & _
  93. scCS & VToSQL(.FirstName, icNON_EMPTY_STRING) & _
  94. scCS & VToSQL(.Address1, icNON_EMPTY_STRING) & _
  95. scCS & VToSQL(.Address2, icNON_EMPTY_STRING) & _
  96. scCS & VToSQL(.City, icNON_EMPTY_STRING) & _
  97. scCS & VToSQL(.State, icNON_EMPTY_STRING) & _
  98. scCS & VToSQL(.ZipCode, icNON_EMPTY_STRING) & _
  99. scCS & VToSQL(.ContactPerson, icNON_EMPTY_STRING) & _
  100. scCS & VToSQL(.PhoneNumber, icNON_EMPTY_STRING) & _
  101. ")"
  102. End With
  103. ' Execute query and return success
  104. If ExecQuery(scDSN, sQry) Then Insert = True
  105. Exit Function
  106. End If
  107. If Not oCustomer Is Nothing Then
  108. ' Inserting a Customer
  109. ' Construct SQL statement
  110. With oCustomer
  111. sQry = "INSERT INTO customers (NickName, LastName, FirstName, Address1, Address2, City, State, ZipCode, PhoneNumber) VALUES (" & _
  112. VToSQL(.NickName, icNON_EMPTY_STRING) & _
  113. scCS & VToSQL(.LastName, icNON_EMPTY_STRING) & _
  114. scCS & VToSQL(.FirstName, icNON_EMPTY_STRING) & _
  115. scCS & VToSQL(.Address1, icNON_EMPTY_STRING) & _
  116. scCS & VToSQL(.Address2, icNON_EMPTY_STRING) & _
  117. scCS & VToSQL(.City, icNON_EMPTY_STRING) & _
  118. scCS & VToSQL(.State, icNON_EMPTY_STRING) & _
  119. scCS & VToSQL(.ZipCode, icNON_EMPTY_STRING) & _
  120. scCS & VToSQL(.PhoneNumber, icNON_EMPTY_STRING) & _
  121. ")"
  122. End With
  123. ' Execute query and return success
  124. If ExecQuery(scDSN, sQry) Then Insert = True
  125. Exit Function
  126. End If
  127. If Not oEmployee Is Nothing Then
  128. ' Inserting an Employee
  129. ' Construct SQL statement
  130. With oEmployee
  131. sQry = "INSERT INTO employees (Alias, LastName, Firstname, MI, SSN, Address1, Address2, City, State, ZipCode, HomePhone, CellPhone, EmergencyContact, EmergencyPhone, HireDate, Password) VALUES (" & _
  132. VToSQL(.Alias, icNON_EMPTY_STRING) & _
  133. scCS & VToSQL(.LastName, icNON_EMPTY_STRING) & _
  134. scCS & VToSQL(.FirstName, icNON_EMPTY_STRING) & _
  135. scCS & VToSQL(.MI, icNON_EMPTY_STRING) & _
  136. scCS & VToSQL(.SSN, icNON_EMPTY_STRING) & _
  137. scCS & VToSQL(.Address1, icNON_EMPTY_STRING) & _
  138. scCS & VToSQL(.Address2, icNON_EMPTY_STRING) & _
  139. scCS & VToSQL(.City, icNON_EMPTY_STRING) & _
  140. scCS & VToSQL(.State, icNON_EMPTY_STRING) & _
  141. scCS & VToSQL(.ZipCode, icNON_EMPTY_STRING) & _
  142. scCS & VToSQL(.HomePhone, icNON_EMPTY_STRING) & _
  143. scCS & VToSQL(.CellPhone, icNON_EMPTY_STRING) & _
  144. scCS & VToSQL(.EmergencyContact, icNON_EMPTY_STRING) & _
  145. scCS & VToSQL(.EmergencyPhone, icNON_EMPTY_STRING) & _
  146. scCS & VToSQL(.HireDate, icDATE) & _
  147. scCS & VToSQL(.Password, icNON_EMPTY_STRING) & _
  148. ")"
  149. End With
  150. ' Execute query and return success
  151. If ExecQuery(scDSN, sQry) Then Insert = True
  152. Exit Function
  153. End If
  154. End Function
  155. Public Function InsertOrder(oOrder As cOrder, cOrderDetails As cOrderDetails) As Boolean
  156. ' Insert an order and order details into database
  157. Dim oConn       As ADODB.Connection
  158. Dim oRset       As ADODB.Recordset
  159. Dim oOrderDet   As cOrderDetail
  160. Dim lOrderId    As Long
  161. Dim lErrNo      As Long
  162. Dim sErrDesc    As String
  163. 'default to false for function
  164. InsertOrder = False
  165. 'enable error handler
  166. On Error GoTo ErrorHandler
  167. 'Get connection
  168. Set oConn = New ADODB.Connection
  169. oConn.Open scDSN
  170. oConn.BeginTrans
  171. Set oRset = New ADODB.Recordset
  172. Set oRset.ActiveConnection = oConn
  173. oRset.CursorType = adOpenKeyset
  174. oRset.LockType = adLockOptimistic
  175. oRset.Open "Orders", , , , adCmdTable
  176. ' record to orders table
  177. oRset.AddNew
  178. With oOrder
  179. If .CustomerId Then oRset!CustomerId = .CustomerId
  180. If .ShippingHandling Then oRset!ShippingHandling = .ShippingHandling
  181. If .Tax Then oRset!Tax = .Tax
  182. End With
  183. oRset.Update
  184. ' get PKId from order record for order details
  185. lOrderId = oRset!PKId
  186. oRset.Close
  187. Set oRset = Nothing
  188. Set oRset = New ADODB.Recordset
  189. Set oRset.ActiveConnection = oConn
  190. oRset.CursorType = adOpenKeyset
  191. oRset.LockType = adLockBatchOptimistic
  192. oRset.Open "OrderDetails", , , , adCmdTable
  193. For Each oOrderDet In cOrderDetails
  194. oRset.AddNew
  195. With oOrderDet
  196. oRset!OrderId = lOrderId
  197. oRset!ItemId = .ItemId
  198. oRset!UnitPrice = .UnitPrice
  199. oRset!Quantity = .Quantity
  200. End With
  201. oRset.Update
  202. Next
  203. oRset.UpdateBatch
  204. oRset.Close
  205. Set oRset = Nothing
  206. oConn.CommitTrans
  207. oConn.Close
  208. Set oConn = Nothing
  209. 'looks like everything worked so set success and exit
  210. InsertOrder = True
  211. Exit Function
  212. 'if we're here there then's been an error so process
  213. ErrorHandler:
  214. 'store incoming values
  215. lErrNo = Err.Number
  216. sErrDesc = Err.Description
  217. 'roll back the transaction, close connection, and signal failure
  218. On Error Resume Next
  219. oConn.RollbackTrans
  220. oConn.Close
  221. InsertOrder = False
  222. On Error GoTo 0
  223. Err.Raise lErrNo, OBJNAME, sErrDesc
  224. End Function
  225. Public Function Update(Optional oContact As cContact, _
  226. Optional oCustomer As cCustomer, _
  227. Optional oEmployee As cEmployee, _
  228. Optional oOrder As cOrder) As Boolean
  229. ' Update contact, customer, employee or order in database
  230. Dim iPrms As Integer
  231. Dim sQry As String
  232. ' Initialize return value
  233. Update = False
  234. ' Allow only one parameter
  235. iPrms = 0
  236. If Not oContact Is Nothing Then
  237. iPrms = iPrms + 1
  238. End If
  239. If iPrms <> 1 Then
  240. Err.Raise icINVALID_PARM_COUNT, OBJNAME, scINVALID_PARM_COUNT
  241. Exit Function
  242. End If
  243. If Not oContact Is Nothing Then
  244. ' Updating a Contact
  245. With oContact
  246. sQry = "UPDATE Contacts SET " & _
  247. scCONTACT_TYPE & " = " & VToSQL(.ContactType, icNON_EMPTY_STRING) & _
  248. scCS & scLAST_NAME & " = " & VToSQL(.LastName, icNON_EMPTY_STRING) & _
  249. scCS & scFIRST_NAME & " = " & VToSQL(.FirstName, icNON_EMPTY_STRING) & _
  250. scCS & scADDRESS_1 & " = "